home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1993 July / InfoMagic USENET CD-ROM July 1993.ISO / sources / misc / volume8 / pcmail / part06 < prev    next >
Encoding:
Text File  |  1989-11-03  |  47.2 KB  |  1,202 lines
  1. Newsgroups: comp.sources.misc
  2. subject: v08i114: pcmail part 06 of 08
  3. From: allbery@uunet.UU.NET (Brandon S. Allbery - comp.sources.misc)
  4. Reply-To: markl@oracle.com (Croaker the Physician)
  5.  
  6. Posting-number: Volume 8, Issue 114
  7. Submitted-by: markl@oracle.com (Croaker the Physician)
  8. Archive-name: pcmail/part06
  9.  
  10. #--------------------------------CUT HERE-------------------------------------
  11. #! /bin/sh
  12. #
  13. # This is a shell archive.  Save this into a file, edit it
  14. # and delete all lines above this comment.  Then give this
  15. # file to sh by executing the command "sh file".  The files
  16. # will be extracted into the current directory owned by
  17. # you with default permissions.
  18. #
  19. # The files contained herein are:
  20. #
  21. # -rw-rw-r--  1 markl       27066 Oct 31 09:10 pcmailsum.el
  22. # -rw-rw-r--  1 markl       13297 Oct 31 11:50 pcmailout.el
  23. # -rw-rw-r--  1 markl        1737 Oct 30 12:23 vms-doprint.com
  24. # -rw-rw-r--  1 markl        2576 Oct 30 12:23 vms-movemail.com
  25. #
  26. echo 'x - pcmailsum.el'
  27. if test -f pcmailsum.el; then echo 'shar: not overwriting pcmailsum.el'; else
  28. sed 's/^X//' << '________This_Is_The_END________' > pcmailsum.el
  29. X;;;; GNU-EMACS PCMAIL mail reader
  30. X
  31. X;;  Written by Mark L. Lambert
  32. X;;  Architecture Group, Network Products Division
  33. X;;  Oracle Corporation
  34. X;;  20 Davis Dr,
  35. X;;  Belmont CA, 94002
  36. X;;
  37. X;;  internet: markl@oracle.com or markl%oracle.com@apple.com
  38. X;;  UUCP:     {hplabs,uunet,apple}!oracle!markl
  39. X
  40. X;; Copyright (C) 1989 Mark L. Lambert
  41. X
  42. X;; This file is not officially part of GNU Emacs, but is being
  43. X;; donated to the Free Software Foundation.  As such, it is
  44. X;; subject to the standard GNU-Emacs General Public License,
  45. X;; referred to below.
  46. X
  47. X;; GNU Emacs is distributed in the hope that it will be useful,
  48. X;; but WITHOUT ANY WARRANTY.  No author or distributor
  49. X;; accepts responsibility to anyone for the consequences of using it
  50. X;; or for whether it serves any particular purpose or works at all,
  51. X;; unless he says so in writing.  Refer to the GNU Emacs General Public
  52. X;; License for full details.
  53. X
  54. X;; Everyone is granted permission to copy, modify and redistribute
  55. X;; GNU Emacs, but only under the conditions described in the
  56. X;; GNU Emacs General Public License.   A copy of this license is
  57. X;; supposed to have been given to you along with GNU Emacs so you
  58. X;; can know your rights and responsibilities.  It should be in a
  59. X;; file named COPYING.  Among other things, the copyright notice
  60. X;; and this notice must be preserved on all copies.
  61. X
  62. X;;;; global variables
  63. X
  64. X;;; system-defined globals
  65. X
  66. X(defvar pcmail-summary-mode-map nil
  67. X  "Keymap for pcmail summary mode.")
  68. X
  69. X;;;; mode definitions 
  70. X
  71. X(if pcmail-summary-mode-map
  72. X    nil
  73. X  (suppress-keymap (setq pcmail-summary-mode-map (make-keymap)))
  74. X  (define-key pcmail-summary-mode-map "?" 'describe-mode)
  75. X  (define-key pcmail-summary-mode-map ">" 'pcmail-summary-last-message)
  76. X  (define-key pcmail-summary-mode-map "<" 
  77. X    '(lambda () (interactive) (pcmail-summary-goto-message 1)))
  78. X  (define-key pcmail-summary-mode-map "." 'pcmail-summary-beginning-of-message)
  79. X  (define-key pcmail-summary-mode-map " " 'pcmail-summary-scroll-message-up)
  80. X  (define-key pcmail-summary-mode-map "a" 'pcmail-summary-archive-message)
  81. X  (define-key pcmail-summary-mode-map "b" 'pcmail-summary-sort-folder)
  82. X  (define-key pcmail-summary-mode-map "c" 'pcmail-summary-copy-message)
  83. X  (define-key pcmail-summary-mode-map "d" 'pcmail-summary-delete-message)
  84. X  (define-key pcmail-summary-mode-map "e" 'pcmail-summary-expunge-folder)
  85. X  (define-key pcmail-summary-mode-map "f" 'pcmail-summary-forward-message)
  86. X  (define-key pcmail-summary-mode-map "g" 'pcmail-summary-get-mail)
  87. X  (define-key pcmail-summary-mode-map "i" 'pcmail-summary-get-mail)
  88. X  (define-key pcmail-summary-mode-map "j" 'pcmail-summary-goto-message)
  89. X  (define-key pcmail-summary-mode-map "k" 'pcmail-summary-kill-message-later)
  90. X  (define-key pcmail-summary-mode-map "m" 'pcmail-summary-mail)
  91. X  (define-key pcmail-summary-mode-map "n" 'pcmail-summary-next-message)
  92. X  (define-key pcmail-summary-mode-map "o" 'pcmail-summary-print-message)
  93. X  (define-key pcmail-summary-mode-map "p" 'pcmail-summary-previous-message)
  94. X  (define-key pcmail-summary-mode-map "q" 'pcmail-summary-quit)
  95. X  (define-key pcmail-summary-mode-map "r" 'pcmail-summary-answer-message)
  96. X  (define-key pcmail-summary-mode-map "s" 'pcmail-summary-save-folder)
  97. X  (define-key pcmail-summary-mode-map "u" 'pcmail-summary-undelete-message)
  98. X  (define-key pcmail-summary-mode-map "w" 'pcmail-summary-edit-message)
  99. X  (define-key pcmail-summary-mode-map "x" 'pcmail-summary-exit)
  100. X  (define-key pcmail-summary-mode-map "y" 'pcmail-summary-change-message-attr)
  101. X  (define-key pcmail-summary-mode-map "\em" 'pcmail-folder-list-folders)
  102. X  (define-key pcmail-summary-mode-map "\C-d" 
  103. X    'pcmail-summary-delete-message-backward)
  104. X  (define-key pcmail-summary-mode-map "\C-m" 'pcmail-summary-next-message)
  105. X  (define-key pcmail-summary-mode-map "\en" 
  106. X    'pcmail-summary-next-message-of-type)
  107. X  (define-key pcmail-summary-mode-map "\ep" 
  108. X    'pcmail-summary-previous-message-of-type)
  109. X  (define-key pcmail-summary-mode-map "\e\C-f"
  110. X    'pcmail-summary-filter-folder)
  111. X  (define-key pcmail-summary-mode-map "\177" 
  112. X    'pcmail-summary-scroll-message-down))
  113. X
  114. X(defun pcmail-summary-mode (owner-name)
  115. X  "Pcmail Summary Mode is used by the summarization commands to manipulate
  116. Xmessages in a summary window.  A subset of the commands available in 
  117. XFolder Mode are supported in this mode. As commands are issued in the 
  118. Xsummary buffer the corresponding mail message (if any) is manipulated
  119. Xand displayed in the owning folder buffer.
  120. X
  121. X\\{pcmail-summary-mode-map}
  122. X
  123. XEntering this mode causes hook variable pcmail-summary-mode-hook to 
  124. Xbe evaluated."
  125. X  (pcmail-mode-setup 'pcmail-summary-mode "Summary" pcmail-summary-mode-map)
  126. X  (put 'pcmail-summary-mode 'mode-class 'special)
  127. X  (make-local-variable 'pcmail-summary-owner)
  128. X  (setq pcmail-summary-owner "[unknown]")
  129. X  (make-local-variable 'pcmail-summary-size)
  130. X  (setq pcmail-summary-size 0)
  131. X  (setq truncate-lines t)
  132. X  (pcmail-set-summary-mode-line-format owner-name)
  133. X  (run-hooks 'pcmail-summary-mode-hook))
  134. X
  135. X(defun pcmail-set-summary-mode-line-format (owner-name)
  136. X  "Set summary buffer's mode line format."
  137. X  (let ((fill-pre (cond (mode-line-inverse-video "") (t "-----")))
  138. X    (fill-post (cond (mode-line-inverse-video " ") (t "%-"))))
  139. X    (setq mode-line-format (list fill-pre "Summary: " 
  140. X                 owner-name
  141. X                 (make-string 
  142. X                  (max 0 (- 18 (length owner-name))) ? )
  143. X                 'global-mode-string fill-post))))
  144. X
  145. X;;; routines to create a message summary
  146. X
  147. X;; create a summary and place it in the summary buffer
  148. X
  149. X(defun pcmail-summarize-folder (&optional folder-name)
  150. X  "Summarize the messages in a folder.  
  151. XArgs: none
  152. X  If called interactively, a prefix argument means ask for the name of a 
  153. Xfolder to summarize, otherwise summarize the current folder.  If called 
  154. Xas a function, supply the name of the folder to summarize, or NIL to 
  155. Xsummarize the current folder."
  156. X  (interactive 
  157. X   (list (and current-prefix-arg (pcmail-read-folder "Summarize folder: "))))
  158. X  (or folder-name
  159. X      (setq folder-name pcmail-folder-name))
  160. X  (or (pcmail-find-folder folder-name)
  161. X      (error "No folder named %s." folder-name))
  162. X  (pcmail-open-folder folder-name)
  163. X  (pcmail-barf-if-empty-folder)
  164. X  (message "Summarizing %s..." folder-name)
  165. X  (or (and pcmail-summary-buffer
  166. X       (buffer-name pcmail-summary-buffer))
  167. X      (setq pcmail-summary-buffer
  168. X        (generate-new-buffer (format "%s-summary" folder-name))))
  169. X  (let ((i 1)
  170. X    (owner-buffer-name (pcmail-folder-buffer-name folder-name))
  171. X    (owner-folder-name pcmail-folder-name)
  172. X    (cmsg pcmail-current-subset-message)
  173. X    (lines)
  174. X    (nlines (pcmail-current-subset-length)))
  175. X    (unwind-protect
  176. X    (save-excursion
  177. X      (save-restriction
  178. X        (widen)
  179. X        (while (<= i (pcmail-current-subset-length))
  180. X          (setq lines 
  181. X            (cons (concat (pcmail-get-summary-line i) "\n") lines))
  182. X          (and (zerop (% (setq i (1+ i)) pcmail-progress-interval))
  183. X           (message "Summarizing %s...%d" folder-name i)))))
  184. X      (pcmail-goto-message cmsg))
  185. X    (setq lines (nreverse lines))
  186. X    (pop-to-buffer pcmail-summary-buffer)
  187. X    (pcmail-summary-mode owner-folder-name)
  188. X    (let ((buffer-read-only nil))
  189. X      (erase-buffer)
  190. X      (mapcar 'insert lines))
  191. X    (goto-char (point-min))
  192. X    (setq pcmail-summary-owner owner-buffer-name
  193. X      pcmail-summary-size nlines)
  194. X    (pcmail-summary-goto-message cmsg)
  195. X    (message "Summarizing %s...done (%d message%s)" folder-name
  196. X         nlines (pcmail-s-ending nlines))))
  197. X
  198. X(defun pcmail-get-summary-line (n)
  199. X  "Return the Nth subset message's summary information.
  200. XArgs: (N)
  201. X  Get message with relative number N's summary line and add to it volatile
  202. Xinformation like message number and D (deleted) or U (unseen) notes.  
  203. XAssumes current buffer is folder buffer that owns this summary."
  204. X  (let* ((abs (pcmail-make-absolute n))
  205. X     (s (or (aref pcmail-summary-vector abs)
  206. X        (aset pcmail-summary-vector abs
  207. X              (pcmail-get-summary-line-1 abs)))))
  208. X    (format "%4d%s %s" 
  209. X        n
  210. X        (cond ((pcmail-has-attribute-p abs "deleted") "D")
  211. X          ((pcmail-has-attribute-p abs "unseen") "U")
  212. X          (t " "))
  213. X        s)))
  214. X
  215. X(defun pcmail-get-summary-line-1 (n)
  216. X  "Get message absolute-numbered N's summary information.
  217. XArgs: (n)
  218. X  Get summary information from message absolute-numbered N's summary-line 
  219. Xfield.  If the field does not exist, create it.  Assume that the current 
  220. Xbuffer is the folder that owns this summary.  Assume current buffer has been 
  221. Xwidened."
  222. X  (let ((line))
  223. X    (save-excursion
  224. X      (save-restriction
  225. X    (pcmail-narrow-to-unpruned-header n)
  226. X    (cond ((not (setq line (mail-fetch-field "summary-line" nil)))
  227. X           (setq line (pcmail-create-summary-line-field n))
  228. X           (goto-char (point-min))
  229. X           (let ((buffer-read-only nil))
  230. X         (insert "Summary-line: " line "\n"))))))
  231. X    line))
  232. X
  233. X(defun pcmail-create-summary-line-field (n)
  234. X  "Create a summary-line field using the header of message absolute-numbered N.
  235. XArgs: (n)
  236. X  Use the format string pcmail-summary-format to format the summary line.
  237. XThe format string can request to, from, subject, cc, bcc, date, or message
  238. XID fields in any combination."
  239. X  (save-excursion
  240. X    (save-restriction
  241. X      (pcmail-narrow-to-unpruned-header n)
  242. X      (pcmail-format-string 
  243. X       pcmail-summary-format
  244. X       (list (list "b" '(lambda ()
  245. X              (pcmail-summary-make-field "bcc")))
  246. X         (list "c" '(lambda ()
  247. X              (pcmail-summary-make-field "cc")))
  248. X         (list "C" '(lambda (n)
  249. X              (pcmail-message-char-count n)) n)
  250. X         (list "d" '(lambda (n) 
  251. X              (let ((arg))
  252. X                (cond ((setq arg (pcmail-message-date n))
  253. X                   (setq arg 
  254. X                     (pcmail-date-triple-to-string arg)))
  255. X                  (t
  256. X                   (setq arg "[unknown]")))
  257. X                arg)) n)
  258. X         (list "f" '(lambda ()
  259. X              (pcmail-summary-make-from)))
  260. X         (list "l" '(lambda (n)
  261. X              (pcmail-message-line-count n)) n)
  262. X         (list "m" '(lambda ()
  263. X              (pcmail-summary-make-field "message-id")))
  264. X         (list "s" '(lambda ()
  265. X              (pcmail-summary-make-field "subject")))
  266. X         (list "t" '(lambda ()
  267. X              (or (pcmail-summary-make-field "to")
  268. X                  (pcmail-summary-make-field "apparently-to")
  269. X                  "") 
  270. X              )))))))
  271. X
  272. X(defun pcmail-summary-concat (s field len neg)
  273. X  "Concatenate S and the first LEN bytes of FIELD.
  274. XArgs: (s field len neg)
  275. X  If LEN is zero use all of FIELD.  If LEN is greater than the length of 
  276. XFIELD, blank-pad on the right, unless NEG is non-nil, in which case blank
  277. Xpad on the left"
  278. X  (let ((blanks (make-string len ? )))
  279. X    (concat s 
  280. X        (if (zerop len) 
  281. X        field            ;all of the field
  282. X          (if (not neg)        ;left-justify
  283. X          (concat (substring field 0 (min len (length field)))
  284. X              (substring blanks 0 
  285. X                     (max 0 (- len (length field)))))
  286. X        (concat (substring blanks 0 (max 0 (- len (length field))))
  287. X            (substring field 0 (min len (length field)))))))))
  288. X  
  289. X(defun pcmail-summary-make-from ()
  290. X  "Return current message's from: summary information .
  291. XArgs: none
  292. X  Create current message's From: summary information.  Assume buffer is
  293. Xnarrowed to desired message's unpruned header.  If the From: field is the 
  294. Xsame as pcmail-primary-folder-name, return the To: field.  Otherwise return 
  295. Xeither the Reply-to: field or the From: field in that order."
  296. X  (let ((from) (to))
  297. X    (setq from (mail-strip-quoted-names 
  298. X        (or (mail-fetch-field "reply-to")
  299. X            (mail-fetch-field "from")
  300. X            " ")))
  301. X    (and (string= (or (and (string-match "\\([^%@]+\\)\\([%@].*\\)?" from)
  302. X               (substring from (match-beginning 1) (match-end 1)))
  303. X              from)
  304. X          pcmail-primary-folder-name)
  305. X     (not (zerop (length (setq to (mail-strip-quoted-names 
  306. X                       (or (mail-fetch-field "to" t)
  307. X                       (mail-fetch-field "apparently-to" t)
  308. X                       ""))))))
  309. X     (setq from (concat "To: " to)))
  310. X    (and (> (length from) 25)
  311. X     (setq from (substring from 0 25)))
  312. X    from))
  313. X
  314. X(defun pcmail-summary-make-field (field)
  315. X  "Create a summary-line field given field name FIELD.  
  316. XArgs: (field)
  317. X  Assume buffer narrowed to msg header.  If the field spans multiple lines,
  318. Xtruncate it before the first newline."
  319. X  (let ((s (mail-fetch-field field)))
  320. X    (cond (s
  321. X       (and (string-match "^[ \t\n]*" s)
  322. X        (setq s (substring s (match-end 0))))
  323. X       (and (string-match "\n" s)
  324. X        (setq s (substring s 0 (match-beginning 0))))
  325. X       s)
  326. X      (t
  327. X       (format "[no %s field]" field)))))
  328. X
  329. X(defun pcmail-summary-pop-to-owner ()
  330. X  "Resummarize current folder if current summary is out of date.
  331. XArgs: (none)"
  332. X  (or (get-buffer pcmail-summary-owner)
  333. X      (error "Owning folder has disappeared!"))
  334. X  (let ((cbuf (current-buffer)))
  335. X    (pop-to-buffer pcmail-summary-owner)
  336. X    (if pcmail-summary-buffer
  337. X    nil
  338. X      (pcmail-summarize-folder)
  339. X      (kill-buffer cbuf)                     ;kill old summary
  340. X      (pop-to-buffer pcmail-summary-owner))))
  341. X
  342. X;;;; summary commands
  343. X
  344. X;;; movement commands: as in folder mode 
  345. X
  346. X(defun pcmail-summary-last-message ()
  347. X  "Move to the last interesting message in the summary and display it.
  348. XArgs: none
  349. X  Call pcmail-last-message interactively.  See pcmail-last-message."
  350. X  (interactive)
  351. X  (let ((curr))
  352. X    (pcmail-summary-pop-to-owner)
  353. X    (call-interactively 'pcmail-last-message)
  354. X    (setq curr pcmail-current-subset-message)
  355. X    (pop-to-buffer pcmail-summary-buffer)
  356. X    (pcmail-summary-goto-message curr)))
  357. X
  358. X(defun pcmail-summary-next-message ()
  359. X  "Move to the next interesting message in the summary and display it.
  360. XArgs: none
  361. X  Call pcmail-next-message interactively.  See pcmail-next-message."
  362. X  (interactive)
  363. X  (let ((curr))
  364. X    (pcmail-summary-goto-message)
  365. X    (pcmail-summary-pop-to-owner)
  366. X    (call-interactively 'pcmail-next-message)
  367. X    (setq curr pcmail-current-subset-message)
  368. X    (pop-to-buffer pcmail-summary-buffer)
  369. X    (pcmail-summary-goto-message curr)))
  370. X
  371. X(defun pcmail-summary-next-message-of-type ()
  372. X  "Move to the next message in the current subset that satisfies a predicate.
  373. XArgs: none
  374. X  Call pcmail-next-message-of-type interactively.  See 
  375. Xpcmail-next-message-of-type."
  376. X  (interactive)
  377. X  (let ((curr))
  378. X    (pcmail-summary-goto-message)
  379. X    (pcmail-summary-pop-to-owner)
  380. X    (unwind-protect
  381. X    (call-interactively 'pcmail-next-message-of-type)
  382. X      (setq curr pcmail-current-subset-message)
  383. X      (pop-to-buffer pcmail-summary-buffer)
  384. X      (pcmail-summary-goto-message curr))))
  385. X
  386. X(defun pcmail-summary-previous-message ()
  387. X  "Move to the previous interesting message in the summary and display it.
  388. XArgs: none
  389. X  Call pcmail-previous-message interactively.  See pcmail-previous-message."
  390. X  (interactive)
  391. X  (let ((curr))
  392. X    (pcmail-summary-goto-message)
  393. X    (pcmail-summary-pop-to-owner)
  394. X    (call-interactively 'pcmail-previous-message)
  395. X    (setq curr pcmail-current-subset-message)
  396. X    (pop-to-buffer pcmail-summary-buffer)
  397. X    (pcmail-summary-goto-message curr)))
  398. X
  399. X(defun pcmail-summary-previous-message-of-type ()
  400. X  "Move to the previous message in the summary that satisfies a predicate.
  401. XArgs: none
  402. X  Call pcmail-previous-message-of-type interactively.  See 
  403. Xpcmail-previous-message-of-type."
  404. X  (interactive)
  405. X  (let ((curr))
  406. X    (pcmail-summary-goto-message)
  407. X    (pcmail-summary-pop-to-owner)
  408. X    (unwind-protect
  409. X    (call-interactively 'pcmail-previous-message-of-type)
  410. X      (setq curr pcmail-current-subset-message)
  411. X      (pop-to-buffer pcmail-summary-buffer)
  412. X      (pcmail-summary-goto-message curr))))
  413. X
  414. X(defun pcmail-summary-beginning-of-message ()
  415. X  "Move to the beginning of the current message.
  416. XArgs: none"
  417. X  (interactive)
  418. X  (pcmail-summary-goto-message)
  419. X  (pcmail-summary-pop-to-owner)
  420. X  (pcmail-beginning-of-message)
  421. X  (pop-to-buffer pcmail-summary-buffer))
  422. X
  423. X(defun pcmail-summary-goto-message (&optional n)
  424. X  "Move to message number N of the summary and display it.
  425. XArgs: (&optional n)
  426. XDisplay message N in the summary.  If called interactively, N is specified 
  427. Xby a numeric prefix argument.  If not specified, N defaults to the first 
  428. Xmessage in the subset."
  429. X  (interactive "P")
  430. X
  431. X  ;; following skullduggery is here in case the user gets silly and either
  432. X  ;; (1) kills the folder which owns this summary, or (2) kills and
  433. X  ;; then re-gets the folder owning this summary.  A folder with no summary
  434. X  ;; will have a pcmail-summary-buffer local variable value of NIL.  If
  435. X  ;; we think we are owned by a folder, and its summary-buffer is NIL, its
  436. X  ;; time to resummarize and kill ourselves (die bravely for Amber...)
  437. X
  438. X  (or (get-buffer pcmail-summary-owner)
  439. X      (error "Owning folder has disappeared!"))
  440. X  (save-excursion
  441. X    (let ((cbuf (current-buffer)))
  442. X      (set-buffer pcmail-summary-owner)
  443. X      (if pcmail-summary-buffer
  444. X      nil
  445. X    (pcmail-summarize-folder)
  446. X    (kill-buffer cbuf))))
  447. X  (and (eobp)
  448. X       (forward-line -1))
  449. X  (beginning-of-line)
  450. X  (let ((msg) (deleted-p) (unseen-p))
  451. X    (if n
  452. X    (setq n (prefix-numeric-value n))
  453. X      (setq n (string-to-int (buffer-substring (point) (+ 5 (point))))))
  454. X    (cond ((< n 1)
  455. X       (setq msg "Beginning of summary"
  456. X         n 1))
  457. X      ((> n pcmail-summary-size)
  458. X       (setq msg "End of summary"
  459. X         n pcmail-summary-size)))
  460. X    (goto-char (point-min))
  461. X    (forward-line (1- n))
  462. X    (save-excursion
  463. X      (set-buffer pcmail-summary-owner)
  464. X      (setq deleted-p (pcmail-has-attribute-p (pcmail-make-absolute n)
  465. X                          "deleted")
  466. X        unseen-p (pcmail-has-attribute-p (pcmail-make-absolute n)
  467. X                         "unseen")))
  468. X    (cond ((/= n 
  469. X           (save-excursion
  470. X         (set-buffer pcmail-summary-owner)
  471. X         pcmail-current-subset-message))
  472. X       (pop-to-buffer pcmail-summary-owner)
  473. X       (pcmail-goto-message n)
  474. X       (pop-to-buffer pcmail-summary-buffer)))
  475. X    (pcmail-summary-set-attr ?U unseen-p)
  476. X    (pcmail-summary-set-attr ?D deleted-p)
  477. X    (and msg
  478. X     (message msg))))
  479. X
  480. X(defun pcmail-summary-set-attr (attr state)
  481. X  "In the summary buffer, set the current message's attribute ATTR to STATE.
  482. XArgs: (attr state)"
  483. X  (let ((buffer-read-only nil))
  484. X    (save-excursion
  485. X      (skip-chars-forward " ")
  486. X      (skip-chars-forward "0-9")
  487. X      (cond ((and (= (following-char) attr)
  488. X          (not state))
  489. X         (delete-char 1)
  490. X         (insert " "))
  491. X        ((and (= (following-char) ? )
  492. X          state)
  493. X         (delete-char 1)
  494. X         (insert attr))))))
  495. X
  496. X(defun pcmail-summary-scroll-message-up (&optional n)
  497. X  "Scroll the current message forward in the other window.
  498. XArgs: none
  499. X  Scroll the current message up in the other window N lines.  If called 
  500. Xinteractively, prefix arg gives number of lines to scroll.  Can't use
  501. Xscroll-other-window because there might be more than two windows on the 
  502. Xscreen."
  503. X  (interactive "P")
  504. X  (pcmail-summary-goto-message)    
  505. X  (pcmail-summary-pop-to-owner)
  506. X  (unwind-protect
  507. X      (scroll-up n)
  508. X    (pop-to-buffer pcmail-summary-buffer)))
  509. X
  510. X(defun pcmail-summary-scroll-message-down (&optional n)
  511. X  "Scroll the current message backward in the other window
  512. XArgs: n
  513. X  Scroll the current message backward in the other window N lines.  If called 
  514. Xinteractively, prefix arg gives number of lines to scroll.  Can't use
  515. Xscroll-other-window because there might be more than two windows on the 
  516. Xscreen."
  517. X  (interactive "P")
  518. X  (pcmail-summary-goto-message)    
  519. X  (pcmail-summary-pop-to-owner)
  520. X  (unwind-protect
  521. X      (scroll-down n)
  522. X    (pop-to-buffer pcmail-summary-buffer)))
  523. X
  524. X;;; attribute-setting commands.  As in folder mode.
  525. X
  526. X(defun pcmail-summary-delete-message ()
  527. X  "Delete this message and move to the next interesting message.
  528. XArgs: none
  529. X  Call pcmail-delete-message interactively.  See pcamil-delete-message."
  530. X  (interactive)
  531. X  (let ((curr) (old) (d))
  532. X    (pcmail-summary-goto-message)    
  533. X    (pcmail-summary-pop-to-owner)
  534. X    (setq old pcmail-current-subset-message)
  535. X    (call-interactively 'pcmail-delete-message)
  536. X    (setq curr pcmail-current-subset-message)
  537. X    (setq d (pcmail-has-attribute-p (pcmail-make-absolute old) "deleted"))
  538. X    (pop-to-buffer pcmail-summary-buffer)
  539. X    (pcmail-summary-set-attr ?D d)
  540. X    (pcmail-summary-goto-message curr)))
  541. X
  542. X(defun pcmail-summary-delete-message-backward ()
  543. X  "Delete this message and move to the previous interesting message.
  544. XArgs: none
  545. X  Call pcmail-delete-message-backward interactively.  See 
  546. Xpcmail-delete-message-backward."
  547. X  (interactive)
  548. X  (let ((curr) (old) (d))
  549. X    (pcmail-summary-goto-message)    
  550. X    (pcmail-summary-pop-to-owner)
  551. X    (setq old pcmail-current-subset-message)
  552. X    (call-interactively 'pcmail-delete-message-backward)
  553. X    (setq curr pcmail-current-subset-message)
  554. X    (setq d (pcmail-has-attribute-p (pcmail-make-absolute old) "deleted"))
  555. X    (pop-to-buffer pcmail-summary-buffer)
  556. X    (pcmail-summary-set-attr ?D d)
  557. X    (pcmail-summary-goto-message curr)))
  558. X
  559. X(defun pcmail-summary-kill-message-later ()
  560. X  "Cause a message to expire at a future date.
  561. XArgs: none
  562. X  Call pcmail-kill-message-later interactivel.. See pcmail-kill-message-later."
  563. X  (interactive)
  564. X  (pcmail-summary-goto-message)
  565. X  (pcmail-summary-pop-to-owner)
  566. X  (unwind-protect
  567. X      (call-interactively 'pcmail-kill-message-later)
  568. X    (pop-to-buffer pcmail-summary-buffer)))
  569. X
  570. X(defun pcmail-summary-undelete-message ()
  571. X  "Looking backward from the current message, clear the first deleted 
  572. Xmessage's delete attribute.
  573. XArgs: none"
  574. X  (interactive)
  575. X  (let ((curr))
  576. X    (pcmail-summary-goto-message)
  577. X    (pcmail-summary-pop-to-owner)
  578. X    (pcmail-undelete-previous-message)
  579. X    (setq curr pcmail-current-subset-message)
  580. X    (pop-to-buffer pcmail-summary-buffer)
  581. X    (pcmail-summary-goto-message curr)))
  582. X
  583. X(defun pcmail-summary-change-message-attr ()
  584. X  "Toggle a named attribute of the current message.  
  585. XArgs: none
  586. X  Call pcmail-change-message-attr interactively.  See 
  587. Xpcmail-change-message-attr."
  588. X  (interactive)
  589. X  (pcmail-summary-goto-message)
  590. X  (pcmail-summary-pop-to-owner)
  591. X  (unwind-protect            ;so C-G leaves you in summary
  592. X      (call-interactively 'pcmail-change-message-attr)
  593. X    (pop-to-buffer pcmail-summary-buffer)
  594. X    (pcmail-summary-goto-message)))    ;to get U/D settings right
  595. X
  596. X;;; output commands: copy, file, print
  597. X
  598. X(defun pcmail-summary-copy-message ()
  599. X  "Copy the current message to a named folder.
  600. XArgs: none
  601. X  Call pcmail-copy-messag einteractively.  See pcmail-copy-message."
  602. X  (interactive)
  603. X  (let ((curr) (d) (old))
  604. X    (pcmail-summary-goto-message)
  605. X    (pcmail-summary-pop-to-owner)
  606. X    (setq old pcmail-current-subset-message)
  607. X    (unwind-protect
  608. X    (call-interactively 'pcmail-copy-message)
  609. X      (setq curr pcmail-current-subset-message)
  610. X      (setq d (pcmail-has-attribute-p (pcmail-make-absolute old) "deleted"))
  611. X      (pop-to-buffer pcmail-summary-buffer)
  612. X      (pcmail-summary-set-attr ?D d)
  613. X      (pcmail-summary-goto-message curr))))
  614. X
  615. X(defun pcmail-summary-print-message ()
  616. X  "Print the current message.
  617. XArgs: none
  618. X  Call pcmail-print-message interactively.  See pcmail-print-message."
  619. X  (interactive)
  620. X  (let ((curr) (d) (old))
  621. X    (pcmail-summary-goto-message)
  622. X    (pcmail-summary-pop-to-owner)
  623. X    (setq old pcmail-current-subset-message)
  624. X    (unwind-protect
  625. X    (call-interactively 'pcmail-print-message)
  626. X      (setq curr pcmail-current-subset-message)
  627. X      (setq d (pcmail-has-attribute-p (pcmail-make-absolute old) "deleted"))
  628. X      (pop-to-buffer pcmail-summary-buffer)
  629. X      (pcmail-summary-set-attr ?D d)
  630. X      (pcmail-summary-goto-message curr))))
  631. X
  632. X(defun pcmail-summary-archive-message ()
  633. X  "Archive the current message.  
  634. XArgs: none
  635. X  Call pcmail-archive-message interactively.  See pcmail-archive-message."
  636. X  (interactive)
  637. X  (let ((curr) (d) (old))
  638. X    (pcmail-summary-goto-message)
  639. X    (pcmail-summary-pop-to-owner)
  640. X    (setq old pcmail-current-subset-message)
  641. X    (unwind-protect
  642. X    (call-interactively 'pcmail-archive-message)
  643. X      (setq curr pcmail-current-subset-message)
  644. X      (setq d (pcmail-has-attribute-p (pcmail-make-absolute old) "deleted"))
  645. X      (pop-to-buffer pcmail-summary-buffer)
  646. X      (pcmail-summary-set-attr ?D d)
  647. X      (pcmail-summary-goto-message curr))))
  648. X
  649. X;;; random other commands
  650. X
  651. X(defun pcmail-summary-get-mail ()
  652. X  "Open a named folder and re-summarize it.
  653. XArgs: none
  654. X  Call pcmail-get-mail interactively.  See pcmail-get-mail."
  655. X  (interactive)
  656. X  (pcmail-summary-pop-to-owner)
  657. X  (call-interactively 'pcmail-get-mail)
  658. X  (pcmail-summarize-folder))
  659. X
  660. X(defun pcmail-summary-filter-folder ()
  661. X  "Filter and re-summarize the current folder.
  662. XArgs: none
  663. X  Call pcmail-filter-folder interactively.  See pcmail-filter-folder."
  664. X  (interactive)
  665. X  (pcmail-summary-pop-to-owner)
  666. X  (unwind-protect
  667. X      (call-interactively 'pcmail-filter-folder)
  668. X    (pcmail-summarize-folder)))
  669. X
  670. X(defun pcmail-summary-edit-message ()
  671. X  "Edit the current message in the other window.
  672. XArgs: none
  673. XCall pcmail-edit-message interactively.  See pcmail-edit-message."
  674. X  (interactive)
  675. X  (pcmail-summary-pop-to-owner)
  676. X  (call-interactively 'pcmail-edit-message))
  677. X
  678. X(defun pcmail-summary-sort-folder ()
  679. X  "Sort the current folder by a key and re-summarize the current folder.
  680. XArgs: none
  681. X  Call pcmail-sort-folder.  See pcmail-sort-folder."
  682. X  (interactive)
  683. X  (pcmail-summary-pop-to-owner)
  684. X  (unwind-protect
  685. X      (call-interactively 'pcmail-sort-folder)
  686. X    (pcmail-summarize-folder)))
  687. X
  688. X(defun pcmail-summary-exit ()
  689. X  "Exit the current summary, returning to the owning folder.
  690. XArgs: none
  691. X  A little skullduggery here since pcmail-summary-owner is a local variable
  692. Xand we need our hands on it after nuking the summary buffer in order to
  693. Xpop back to the owner."
  694. X  (interactive)
  695. X  (pop-to-buffer (prog1 (or (get-buffer pcmail-summary-owner)
  696. X                (other-buffer))
  697. X           (bury-buffer (current-buffer))))
  698. X  (delete-other-windows))
  699. X
  700. X(defun pcmail-summary-quit ()
  701. X  "Exit the mail reader.  See pcmail-quit.
  702. XArgs: none"
  703. X  (interactive)
  704. X  (pcmail-summary-exit)
  705. X  (call-interactively 'pcmail-quit))
  706. X
  707. X(defun pcmail-summary-expunge-folder ()
  708. X  "Expunge and re-summarize the current folder.
  709. XArgs: none
  710. X  Call pcmail-expunge-folder.  See pcmail-expunge-folder."
  711. X  (interactive)
  712. X  (pcmail-summary-pop-to-owner)
  713. X  (unwind-protect
  714. X      (pcmail-expunge-folder)
  715. X    (pcmail-summarize-folder)))    ;in case expunge changed #messages
  716. X
  717. X(defun pcmail-summary-save-folder ()
  718. X  "Save and re-summarize the current folder.
  719. XArgs: none
  720. X  Call pcmail-save-folder.  See pcmail-save-folder"
  721. X  (interactive)
  722. X  (pcmail-summary-pop-to-owner)
  723. X  (unwind-protect
  724. X      (pcmail-save-folder)
  725. X    (pcmail-summarize-folder)))    ;in case expunge changed #messages
  726. X
  727. X(defun pcmail-summary-answer-message ()
  728. X  "Reply to the current message.
  729. XArgs: none
  730. X  Call pcmail-answer-message interactively.  See pcmail-answer-message.  
  731. XNote that sending the message does not return you to the summary window, 
  732. Xbut instead leaves you at the current message in the folder."
  733. X  (interactive)
  734. X  (pcmail-summary-pop-to-owner)
  735. X  (call-interactively 'pcmail-answer-message))
  736. X
  737. X(defun pcmail-summary-mail ()
  738. X  "Compose mail in another window.
  739. XArgs: none
  740. X  Call pcmail-mail interactively.  See pcmail-mail.  Note that sending 
  741. Xthe message does not return you to the summary window, but instead
  742. Xleaves you at the current message in the folder."
  743. X  (interactive)
  744. X  (pcmail-summary-pop-to-owner)
  745. X  (call-interactively 'pcmail-mail))
  746. X
  747. X(defun pcmail-summary-forward-message ()
  748. X  "Forward the current message.
  749. XArgs: none
  750. X  Call pcmail-forward-message interactively.  See pcmail-forward-message.  
  751. XNote that sending the message does not return you to the summary window, 
  752. Xbut instead leaves you at the current message in the folder."
  753. X  (interactive)
  754. X  (pcmail-summary-pop-to-owner)
  755. X  (call-interactively 'pcmail-forward-message))
  756. X
  757. X(provide 'pcmailsum)
  758. ________This_Is_The_END________
  759. if test `wc -c < pcmailsum.el` -ne 27066; then
  760.     echo 'shar: pcmailsum.el was damaged during transit (should have been 27066 bytes)'
  761. fi
  762. fi        ; : end of overwriting check
  763. echo 'x - pcmailout.el'
  764. if test -f pcmailout.el; then echo 'shar: not overwriting pcmailout.el'; else
  765. sed 's/^X//' << '________This_Is_The_END________' > pcmailout.el
  766. X;;;; GNU-EMACS PCMAIL mail reader
  767. X
  768. X;;  Written by Mark L. Lambert
  769. X;;  Architecture Group, Network Products Division
  770. X;;  Oracle Corporation
  771. X;;  20 Davis Dr,
  772. X;;  Belmont CA, 94002
  773. X;;
  774. X;;  internet: markl@oracle.com or markl%oracle.com@apple.com
  775. X;;  UUCP:     {hplabs,uunet,apple}!oracle!markl
  776. X
  777. X;; Copyright (C) 1989 Mark L. Lambert
  778. X
  779. X;; This file is not officially part of GNU Emacs, but is being
  780. X;; donated to the Free Software Foundation.  As such, it is
  781. X;; subject to the standard GNU-Emacs General Public License,
  782. X;; referred to below.
  783. X
  784. X;; GNU Emacs is distributed in the hope that it will be useful,
  785. X;; but WITHOUT ANY WARRANTY.  No author or distributor
  786. X;; accepts responsibility to anyone for the consequences of using it
  787. X;; or for whether it serves any particular purpose or works at all,
  788. X;; unless he says so in writing.  Refer to the GNU Emacs General Public
  789. X;; License for full details.
  790. X
  791. X;; Everyone is granted permission to copy, modify and redistribute
  792. X;; GNU Emacs, but only under the conditions described in the
  793. X;; GNU Emacs General Public License.   A copy of this license is
  794. X;; supposed to have been given to you along with GNU Emacs so you
  795. X;; can know your rights and responsibilities.  It should be in a
  796. X;; file named COPYING.  Among other things, the copyright notice
  797. X;; and this notice must be preserved on all copies.
  798. X
  799. X;;;; global variables
  800. X
  801. X;;; defaults
  802. X
  803. X(defvar pcmail-last-file (expand-file-name "~/pcmail-archive")
  804. X  "The name of the last file given to an archive command.")
  805. X
  806. X;;;; Pcmail output and copy commands by single message and subset
  807. X
  808. X;;; archive a message or current subset
  809. X
  810. X(defun pcmail-archive-subset (file dont-delete)
  811. X  "Archive the current message subset.
  812. XArgs: (file dont-delete)
  813. X  Append the current message subset to the file named by pcmail-last-file.
  814. XIf the variable pcmail-delete-on-archive is non-NIL, set the deleted attribute
  815. Xon all messages in the subset after archiving.  If called interactively, a 
  816. Xprefix argument means do not delete after archiving no matter what the
  817. Xsetting of pcmail-delete-on-archive.  Archived messages have their archived 
  818. Xattribute set upon archiving."
  819. X  (interactive
  820. X   (list
  821. X    (setq pcmail-last-file 
  822. X      (pcmail-read-file-name "Archive subset to file: " pcmail-last-file))
  823. X    current-prefix-arg))
  824. X  (pcmail-barf-if-empty-folder)
  825. X  (pcmail-archive-message-1 file dont-delete 1 (pcmail-current-subset-length)))
  826. X
  827. X(defun pcmail-archive-message (file dont-delete)
  828. X  "Archive the current message.
  829. XArgs: (file dont-delete)
  830. X  Append this message to the file named by pcmail-last-file.  If the variable 
  831. Xpcmail-delete-on-archive is non-NIL, set this message's deleted attribute 
  832. Xafter archiving, and move to the next interesting message in the folder.  
  833. XIf called interactively, a prefix argument means do not delete after archiving
  834. Xno matter what the setting of pcmail-delete-on-archive.  Set the message's 
  835. Xarchived attribute."
  836. X  (interactive
  837. X   (list
  838. X    (setq pcmail-last-file
  839. X      (pcmail-read-file-name "Archive message to file: " pcmail-last-file))
  840. X    current-prefix-arg))
  841. X  (pcmail-barf-if-empty-folder)
  842. X  (pcmail-archive-message-1 file dont-delete pcmail-current-subset-message 1))
  843. X
  844. X(defun pcmail-archive-message-1 (file-name dont-delete start len)
  845. X  "Archive a portion of the current message subset.
  846. XArgs: (file-name dont-delete start len)
  847. X  Append to FILE-NAME all messages in the current subset, from message START 
  848. Xfor LEN messages.  Set the archived attribute on all archived messages.  Set 
  849. Xthe deleted attribute on all archived messages if pcmail-delete-on-archive 
  850. Xis non-NIL and DONT-DELETE is NIL.  If any messages were deleted, move to 
  851. Xthe next interesting message in the subset after archiving."
  852. X  (let ((cbuf (current-buffer)) (i start))
  853. X    (message "Archiving...")
  854. X    (unwind-protect
  855. X    (while (< i (+ start len))
  856. X      (pcmail-narrow-to-message (pcmail-make-absolute i))
  857. X      (let ((beg (point-min))
  858. X        (end (point-max)))
  859. X        (save-excursion
  860. X          (find-file file-name)
  861. X          (goto-char (point-max))
  862. X          (insert-buffer-substring cbuf beg end)
  863. X          (insert "\n\n"))
  864. X        (pcmail-set-attribute (pcmail-make-absolute i) "filed" t)
  865. X        (and pcmail-delete-on-archive 
  866. X         (not dont-delete)
  867. X         (pcmail-set-attribute (pcmail-make-absolute i) "deleted" 
  868. X                       t)))
  869. X      (and (zerop (% (- (setq i (1+ i)) start) pcmail-progress-interval))
  870. X           (message "Archiving...%d" (- i start))))
  871. X      (and pcmail-delete-on-archive
  872. X       (not dont-delete)
  873. X       (pcmail-next-message))
  874. X      (pcmail-update-folder-mode-line pcmail-current-subset-message)
  875. X      (save-excursion
  876. X    (find-file file-name)
  877. X    (save-buffer)
  878. X    (bury-buffer (current-buffer))))
  879. X    (message "Archiving...done (%d message%s)" (- i start) 
  880. X         (pcmail-s-ending (- i start)))))
  881. X
  882. X;;; print a message or current subset
  883. X
  884. X(defun pcmail-print-subset (printer dont-delete)
  885. X  "Print each message in the current subset.
  886. XArgs: (printer dont-delete)
  887. X  Send the current message subset to a named printer.  The default printer 
  888. Xis specified by the variable pcmail-printer-name.  A system-dependent print
  889. Xroutine set up in pcmail-mail-environment prints the message.  If the 
  890. Xvariable pcmail-delete-on-print is non-NIL, set the deleted attribute of all 
  891. Xmessages in the subset after printing.  If called interactively,
  892. Xa prefix argument means do not delete after printing no matter what the
  893. Xsetting of pcmail-delete-on-print.  Printed messages have their printed 
  894. Xattribute set upon printing."
  895. X  (interactive
  896. X      (list (setq pcmail-printer-name 
  897. X          (pcmail-read-string-default "Send subset to printer: " 
  898. X                          pcmail-printer-name
  899. X                          t))
  900. X        current-prefix-arg))  
  901. X  (pcmail-barf-if-empty-folder)
  902. X  (pcmail-print-message-1 printer dont-delete 1 
  903. X              (pcmail-current-subset-length)))
  904. X
  905. X(defun pcmail-print-message (printer dont-delete)
  906. X  "Print the current message.
  907. XArgs: (printer dont-delete)
  908. X  Send the current message to a named printer.  The default printer is 
  909. Xspecified by the variable pcmail-printer-name.  A system-dependent print
  910. Xroutine set up in pcmail-mail-environment prints the message.  If the 
  911. Xvariable pcmail-delete-on-print is non-NIL, set the message's deleted 
  912. Xattribute after printing, and move to the next interesting message in the 
  913. Xfolder.  If called interactively, a prefix argument means do not delete 
  914. Xafter printing no matter what the setting of pcmail-delete-on-print.
  915. XSet the message's printed attribute."
  916. X  (interactive
  917. X      (list (setq pcmail-printer-name 
  918. X          (pcmail-read-string-default "Send message to printer: " 
  919. X                          pcmail-printer-name t))
  920. X        current-prefix-arg))
  921. X  (pcmail-barf-if-empty-folder)
  922. X  (pcmail-print-message-1 printer dont-delete pcmail-current-subset-message 1))
  923. X
  924. X(defun pcmail-print-message-1 (printer-name dont-delete start len)
  925. X  "Print a portion of the current subset.
  926. XArgs: (printer-name dont-delete start len)
  927. X  Send to PRINTER-NAME all messages in the current subset, from message START 
  928. Xfor LEN messages.  Set the printed attribute on all printed messages.  Set 
  929. Xthe deleted attribute on all printed messages if pcmail-delete-on-print is 
  930. Xnon-NIL and DONT-DELETE is NIL.  If any messages were deleted, move to the 
  931. Xnext interesting message in the subset after printing."
  932. X  (let ((folder-name pcmail-folder-name) (i start))
  933. X    (message "Printing...")
  934. X    (unwind-protect
  935. X    (while (< i (+ start len))
  936. X      (pcmail-narrow-to-message (pcmail-make-absolute i))
  937. X      (save-excursion
  938. X        (funcall (get 'pcmail-mail-environment 'print-function) 
  939. X             printer-name folder-name)
  940. X        (pcmail-set-attribute (pcmail-make-absolute i) "printed" t)
  941. X        (and pcmail-delete-on-print 
  942. X         (not dont-delete)
  943. X         (pcmail-set-attribute (pcmail-make-absolute i) "deleted" t)))
  944. X      (and (zerop (% (- (setq i (1+ i)) start) pcmail-progress-interval))
  945. X           (message "Printing...%d" (- i start))))
  946. X      (and pcmail-delete-on-print
  947. X       (not dont-delete)
  948. X       (pcmail-next-message))
  949. X      (pcmail-update-folder-mode-line pcmail-current-subset-message))
  950. X    (message "Printing...done (%d message%s)" (- i start)
  951. X         (pcmail-s-ending (- i start)))))
  952. X   
  953. X;;; copy a message or current subset
  954. X
  955. X(defun pcmail-copy-subset (folder-name dont-delete)
  956. X  "Copy to a named folder each message in the current subset.
  957. XArgs: (folder-name dont-delete)
  958. X  Copy the current message subset to a named folder.  If called interactively,
  959. Xrequest a folder name from the minibuffer.  Completion of input is permitted;
  960. Xinput defaults to the name of the last folder given to a folder command.
  961. XIf the variable pcmail-delete-on-copy is non-NIL, set the deleted attribute 
  962. Xof all messages in the subset after copying.  If called interactively,
  963. Xa prefix argument means do not delete after copying no matter what the
  964. Xsetting of pcmail-delete-on-copy.  Copied messages have their copied
  965. Xattribute set upon copying."
  966. X  (interactive
  967. X      (list (pcmail-read-folder "Copy subset to folder: ") 
  968. X        current-prefix-arg))
  969. X  (pcmail-barf-if-empty-folder)
  970. X  (pcmail-copy-message-1 folder-name dont-delete 1 
  971. X             (pcmail-current-subset-length))
  972. X  (pcmail-update-folder-mode-line pcmail-current-subset-message))
  973. X
  974. X(defun pcmail-copy-message (folder-name dont-delete)
  975. X  "Copy the current message to a named folder.
  976. XArgs: (folder-name dont-delete)
  977. X  Copy the current message to a named folder.  If called interactively,
  978. Xrequest a folder name from the minibuffer.  Completion of input is permitted;
  979. Xinput defaults to the name of the last folder given to a folder command.
  980. XIf the variable pcmail-delete-on-copy is non-NIL, set the message's deleted 
  981. Xattribute after copying, and move to the next interesting message in the 
  982. Xfolder.  If called interactively, a prefix argument means do not delete 
  983. Xafter copying no matter what the setting of pcmail-delete-on-copy.  Set the
  984. Xmessage's copied attribute."
  985. X  (interactive
  986. X      (list (pcmail-read-folder "Copy message to folder: ")
  987. X        current-prefix-arg))
  988. X  (pcmail-barf-if-empty-folder)
  989. X  (pcmail-copy-message-1 folder-name dont-delete pcmail-current-subset-message
  990. X             1)
  991. X  (and pcmail-delete-on-copy
  992. X       (not dont-delete)
  993. X       (pcmail-next-message))
  994. X  (pcmail-update-folder-mode-line pcmail-current-subset-message))
  995. X
  996. X(defun pcmail-copy-message-1 (target-folder-name dont-delete start len)
  997. X  "Print a portion of the current subset.
  998. XArgs: (target-folder-name dont-delete start len)
  999. X  Copy to FOLDER-NAME all messages in the current subset, from message START 
  1000. Xfor LEN messages.  Set the copied attribute on all copied messages.  Set 
  1001. Xthe deleted attribute on all copied messages if pcmail-delete-on-copy is 
  1002. Xnon-NIL and DONT-DELETE is NIL.  If any messages were deleted, move to the 
  1003. Xnext interesting message in the subset after copying."
  1004. X  (let ((source-folder-name pcmail-folder-name) (eom) (i start))
  1005. X    (and (string= target-folder-name source-folder-name) 
  1006. X     (error "Cannot copy message into itself"))
  1007. X    (or (pcmail-find-folder target-folder-name)
  1008. X    (error "Target folder %s not found" target-folder-name))
  1009. X    (save-excursion
  1010. X      (pcmail-open-folder target-folder-name)
  1011. X      (save-restriction
  1012. X    (widen)
  1013. X    (setq eom (point-max))))
  1014. X    (message "Copying to %s..." target-folder-name)
  1015. X    (unwind-protect
  1016. X    (while (< i (+ start len))
  1017. X      (pcmail-perform-copy source-folder-name target-folder-name i)
  1018. X      (pcmail-set-attribute (pcmail-make-absolute i) "copied" t)
  1019. X      (and pcmail-delete-on-copy
  1020. X           (not dont-delete)
  1021. X           (pcmail-set-attribute (pcmail-make-absolute i) "deleted" t))
  1022. X      (and (zerop (% (- (setq i (1+ i)) start) pcmail-progress-interval))
  1023. X           (message "Copying to %s...%d" target-folder-name 
  1024. X            (- i start))))
  1025. X
  1026. X      ; and now update target folder
  1027. X      (save-excursion
  1028. X    (set-buffer (pcmail-folder-buffer-name target-folder-name))
  1029. X    (pcmail-save-buffer)
  1030. X    (pcmail-set-message-vectors eom)
  1031. X    (pcmail-narrow-to-message 
  1032. X     (pcmail-make-absolute pcmail-current-subset-message))
  1033. X    (pcmail-set-nmessages target-folder-name pcmail-total-messages)
  1034. X    (pcmail-change-in-folder-list target-folder-name 
  1035. X                       pcmail-total-messages)))
  1036. X    (message "Copying to %s...done (%d message%s)" target-folder-name
  1037. X         (- i start) (pcmail-s-ending (- i start)))))
  1038. X
  1039. X(defun pcmail-perform-copy (source target n)
  1040. X  "Append message absolute-numbered N in source folder to target folder.
  1041. XArgs: (source target n)"
  1042. X  (let ((msg (pcmail-message-contents (pcmail-make-absolute n))))
  1043. X    (save-excursion
  1044. X      (save-restriction
  1045. X    (set-buffer (pcmail-folder-buffer-name target))
  1046. X    (widen)
  1047. X    (goto-char (point-max))
  1048. X    (let ((buffer-read-only nil))
  1049. X      (insert msg))))))
  1050. X
  1051. X(defun pcmail-wastebasket-message (start len)
  1052. X  "Copy a portion of the current message subset to the wastebasket folder.
  1053. XArgs: (start len)
  1054. X  If the current folder is not the wastebasket, copy part of the current
  1055. Xfolder to the wastebasket.  Ask to create pcmail-wastebasket-folder if it 
  1056. Xdoes not exist.  Then call pcmail-copy-message-1 to perform the copy."
  1057. X  (cond ((not (string= pcmail-folder-name pcmail-wastebasket-folder))
  1058. X     (cond ((not (pcmail-find-folder pcmail-wastebasket-folder))
  1059. X        (or (yes-or-no-p (concat "Wastebasket folder \"" 
  1060. X                     pcmail-wastebasket-folder
  1061. X                     "\" does not exist.  Create? "))
  1062. X            (error "Aborted."))
  1063. X        (pcmail-create-folder pcmail-wastebasket-folder)))
  1064. X     (save-excursion
  1065. X       (save-restriction
  1066. X         (pcmail-copy-message-1 pcmail-wastebasket-folder nil start
  1067. X                    len))))))
  1068. X
  1069. X(provide 'pcmailout)
  1070. ________This_Is_The_END________
  1071. if test `wc -c < pcmailout.el` -ne 13297; then
  1072.     echo 'shar: pcmailout.el was damaged during transit (should have been 13297 bytes)'
  1073. fi
  1074. fi        ; : end of overwriting check
  1075. echo 'x - vms-doprint.com'
  1076. if test -f vms-doprint.com; then echo 'shar: not overwriting vms-doprint.com'; else
  1077. sed 's/^X//' << '________This_Is_The_END________' > vms-doprint.com
  1078. X$ !  GNU-EMACS PCMAIL mail reader support utility
  1079. X$ ! 
  1080. X$ !  Written by Mark L. Lambert
  1081. X$ !  Architecture Group, Network Products Division
  1082. X$ !  Oracle Corporation
  1083. X$ !  20 Davis Dr,
  1084. X$ !  Belmont CA, 94002
  1085. X$ ! 
  1086. X$ !  internet: markl@oracle.com or markl%oracle.com@apple.com
  1087. X$ !  UUCP:     {hplabs,uunet,apple}!oracle!markl
  1088. X$ ! 
  1089. X$ ! Copyright (C) 1989 Mark L. Lambert
  1090. X$ !
  1091. X$ ! This file is not officially part of GNU Emacs, but is being
  1092. X$ ! donated to the Free Software Foundation.  As such, it is
  1093. X$ ! subject to the standard GNU-Emacs General Public License,
  1094. X$ ! referred to below.
  1095. X$ ! 
  1096. X$ ! GNU Emacs is distributed in the hope that it will be useful,
  1097. X$ ! but WITHOUT ANY WARRANTY.  No author or distributor
  1098. X$ ! accepts responsibility to anyone for the consequences of using it
  1099. X$ ! or for whether it serves any particular purpose or works at all,
  1100. X$ ! unless he says so in writing.  Refer to the GNU Emacs General Public
  1101. X$ ! License for full details.
  1102. X$ ! 
  1103. X$ ! Everyone is granted permission to copy, modify and redistribute
  1104. X$ ! GNU Emacs, but only under the conditions described in the
  1105. X$ ! GNU Emacs General Public License.   A copy of this license is
  1106. X$ ! supposed to have been given to you along with GNU Emacs so you
  1107. X$ ! can know your rights and responsibilities.  It should be in a
  1108. X$ ! file named COPYING.  Among other things, the copyright notice
  1109. X$ ! and this notice must be preserved on all copies.
  1110. X$ !
  1111. X$ ! COM file to send a named file to a named printer queue via EMACS
  1112. X$ ! P1 is the printer queue name, P2 is the file to print, and
  1113. X$ ! if parameter P3 is "delete", delete P2 after printing
  1114. X$
  1115. X$ ! define /user_mode sys$output dcl-junk.txt
  1116. X$ print /queue='p1' 'p2'
  1117. X$ if p3 .eqs. "delete" then del 'p2'.*
  1118. X$ ! delete dcl-junk.txt.*
  1119. X$ exit
  1120. ________This_Is_The_END________
  1121. if test `wc -c < vms-doprint.com` -ne 1737; then
  1122.     echo 'shar: vms-doprint.com was damaged during transit (should have been 1737 bytes)'
  1123. fi
  1124. fi        ; : end of overwriting check
  1125. echo 'x - vms-movemail.com'
  1126. if test -f vms-movemail.com; then echo 'shar: not overwriting vms-movemail.com'; else
  1127. sed 's/^X//' << '________This_Is_The_END________' > vms-movemail.com
  1128. X$ !  GNU-EMACS PCMAIL mail reader support utility
  1129. X$
  1130. X$ !  Written by Mark L. Lambert
  1131. X$ !  Architecture Group, Network Products Division
  1132. X$ !  Oracle Corporation
  1133. X$ !  20 Davis Dr,
  1134. X$ !  Belmont CA, 94002
  1135. X$
  1136. X$ !  internet: markl@oracle.com or markl%oracle.com@apple.com
  1137. X$ !  UUCP:     {hplabs,uunet,apple}!oracle!markl
  1138. X$ !
  1139. X$ ! Copyright (C) 1989 Mark L. Lambert
  1140. X$ !
  1141. X$ ! This file is not officially part of GNU Emacs, but is being
  1142. X$ ! donated to the Free Software Foundation.  As such, it is
  1143. X$ ! subject to the standard GNU-Emacs General Public License,
  1144. X$ ! referred to below.
  1145. X$ ! 
  1146. X$ ! GNU Emacs is distributed in the hope that it will be useful,
  1147. X$ ! but WITHOUT ANY WARRANTY.  No author or distributor
  1148. X$ ! accepts responsibility to anyone for the consequences of using it
  1149. X$ ! or for whether it serves any particular purpose or works at all,
  1150. X$ ! unless he says so in writing.  Refer to the GNU Emacs General Public
  1151. X$ ! License for full details.
  1152. X$ ! 
  1153. X$ ! Everyone is granted permission to copy, modify and redistribute
  1154. X$ ! GNU Emacs, but only under the conditions described in the
  1155. X$ ! GNU Emacs General Public License.   A copy of this license is
  1156. X$ ! supposed to have been given to you along with GNU Emacs so you
  1157. X$ ! can know your rights and responsibilities.  It should be in a
  1158. X$ ! file named COPYING.  Among other things, the copyright notice
  1159. X$ ! and this notice must be preserved on all copies.
  1160. X$
  1161. X$ ! COM file to transfer new mail from VMS into an ASCII file readable by
  1162. X$ ! EMACS.  If there is no new mail, mail.temp;1 is empty.
  1163. X$ ! P1 is folder from which to select (currently ignored)
  1164. X$ ! P2 is name of temp file to finally leave extracted mail in
  1165. X$ ! P3 is mail reader directory
  1166. X$ 
  1167. X$ ! This COM files works fine on our local VMS 5.1.  Since it does delete 
  1168. X$ ! mail in the newmail folder after extracting, it would be a very good
  1169. X$ ! idea to perform a test on some test messages before trusting it on your
  1170. X$ ! system.  I don't understand VMS all that well (and have no desire to),
  1171. X$ ! so this file may not be bulletproof.
  1172. X$
  1173. X$ msg = f$environment("message")
  1174. X$ set message /noident/notext/noseverity/nofacility
  1175. X$ set default 'p3'
  1176. X$ tempfile = "$$extract$$.temp"
  1177. X$ dropfile = "'p2'"
  1178. X$ del 'tempfile'.*,'dropfile'.*
  1179. X$ !emacs dcl-command fn chokes on output so reroute to file and delete later
  1180. X$ define /user_mode sys$output dcl-junk.txt
  1181. X$ mail
  1182. Xselect newmail
  1183. Xextract/all $$extract$$.temp
  1184. Xdelete/all
  1185. Xpurge/reclaim
  1186. Xexit
  1187. X$ delete dcl-junk.txt.*
  1188. X$ exists_p = f$search(tempfile)
  1189. X$ if exists_p .eqs. "" then create 'tempfile'
  1190. X$ rename 'tempfile' 'dropfile'
  1191. X$ set message 'msg'
  1192. X$ exit
  1193. X
  1194. X
  1195. ________This_Is_The_END________
  1196. if test `wc -c < vms-movemail.com` -ne 2576; then
  1197.     echo 'shar: vms-movemail.com was damaged during transit (should have been 2576 bytes)'
  1198. fi
  1199. fi        ; : end of overwriting check
  1200. exit 0
  1201.  
  1202.